home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / euphor14.zip / SANITY.EX < prev    next >
Text File  |  1996-10-16  |  20KB  |  947 lines

  1.         ------------------------------------------
  2.         -- AUTOMATIC SELF-CHECKING SANITY TEST  --
  3.         -- for Euphoria                         --
  4.         -- A quick test of most of the features --
  5.         ------------------------------------------
  6. with type_check
  7. with trace
  8. include get.e
  9. include graphics.e  -- comment after include is ok
  10. include sort.e
  11. include machine.e
  12. include file.e
  13. include wildcard.e
  14. include image.e
  15.  
  16. trace(0)
  17.  
  18. constant msg = 1 -- place to send messages
  19.  
  20. object y, i, r
  21.  
  22. procedure the_end()
  23.     if atom(gets(0)) then
  24.     end if
  25.     if graphics_mode(-1) then
  26.     end if
  27.     abort(0)
  28. end procedure
  29.  
  30. procedure make_sound()
  31. -- test sound() built-in
  32.     for i = 400 to 4000 by 400 do
  33.     sound(i)
  34.     for j = 1 to 100000 do
  35.     end for
  36.     sound(0)
  37.     end for
  38. end procedure
  39.  
  40. without warning
  41. procedure abort()
  42. -- force abort with trace back
  43.     puts(msg, "\ndivide by 0 to get trace back...Press Enter\n")
  44.     if sequence(gets(0)) then
  45.     end if
  46.     ? 1/0
  47. end procedure
  48. with warning
  49.  
  50. procedure show(object x, object y)
  51. -- show the mismatched values
  52.     puts(msg, "\n   ---MISMATCH--- \n   x is ")
  53.     ? x
  54.     puts(msg, "   y is ")
  55.     ? y
  56.     abort()
  57. end procedure
  58.  
  59. constant epsilon = 1e-10 -- allow for small floating point inaccuracy
  60.  
  61. procedure same(object x, object y)
  62. -- object x must be identical to object y else abort program
  63.     atom ratio
  64.  
  65.     if atom(x) and atom(y) then
  66.     if x = y then
  67.         return
  68.     else
  69.         if y = 0 then
  70.         show(x, y)
  71.         else
  72.         ratio = x / y
  73.         if ratio < 1 - epsilon or ratio > 1 + epsilon then
  74.             show(x, y)
  75.         end if
  76.         end if
  77.     end if
  78.     elsif length(x) = length(y) then
  79.     for i = 1 to length(x) do
  80.         same(x[i], y[i])
  81.     end for
  82.     else
  83.     show(x, y)
  84.     end if
  85. end procedure
  86.  
  87. function abs(atom x)
  88. -- absolute value
  89.     if x < 0 then
  90.     return -x
  91.     else
  92.     return x
  93.     end if
  94. end function
  95.  
  96. function built_in()
  97. -- built-in tests
  98.     sequence d
  99.  
  100.     d = date()
  101.     if d[1] < 93 or d[2] > 12 or d[3] < 1 or d[4] > 23 or d[5] > 59 or
  102.     d[6] >59 or d[7] > 7  or d[8] > 366 then
  103.     abort()
  104.     end if
  105.     d = power({-5, -4.5, -1,  0, 1,  2,  3.5, 4, 6},
  106.           { 3,    2, -1,0.5, 0, 29, -2.5, 5, 8})
  107.     if d[1] != -125 or d[2] != 20.25 or d[3] != -1 or d[4] != 0 then
  108.     abort()
  109.     end if 
  110.     if d[5] != 1 or d[6] != 536870912 or d[7] <.043 or d[7] > .044 then
  111.     abort()
  112.     end if
  113.     if d[8] != 1024 or d[9] != 1679616 or power(2,3) != 8 then
  114.     abort()
  115.     end if
  116.     same(power(16, 0.5), 4)
  117.     d = remainder({5, 9, 15, -27}, {3, 4, 5, 6})
  118.     if d[1] != 2 or d[2] != 1 or d[3] != 0 or d[4] != -3 then
  119.     abort()
  120.     end if
  121.     d = remainder({11.5, -8.8, 3.5, 5.0}, {2, 3.5, -1.5, -100.0})
  122.     if d[1] != 1.5 or d[2] < -1.81 or d[2] > -1.79 or d[3] != 0.5 or d[4] != 5 then
  123.     abort()
  124.     end if
  125.     same(4, sqrt(16))
  126.     same(3, length("ABC"))
  127.     same({1, 1, 1, 1}, repeat(1, 4))
  128.     if rand(10) > 10 or rand(20) < 1 or not find(rand(5.5), {1,2,3,4,5}) then
  129.     abort()
  130.     end if
  131.     set_rand(5555)
  132.     d = rand(repeat(10,20))
  133.     set_rand(5555)
  134.     if compare(d, rand(repeat(10,20))) != 0 then
  135.     abort()
  136.     end if
  137.     if time() < 0 then
  138.     abort()
  139.     end if
  140.     if abs(sin(3.1415)) > 0.02 then
  141.     abort()
  142.     end if
  143.     if cos(0) < .98 then
  144.     abort()
  145.     end if
  146.     if abs(tan(3.14/4) - 1) > .02 then
  147.     abort()
  148.     end if
  149.     if log(2.7) < 0.8 or log(2.7) > 1.2 then
  150.     abort()
  151.     end if
  152.     if floor(-3.3) != -4 then
  153.     abort()
  154.     end if
  155.     if floor(-999/3.000000001) != -333 then
  156.     abort()
  157.     end if
  158.     if floor(9.99/1) != 9 then
  159.     abort()
  160.     end if
  161.     for i = -9 to 2 do
  162.     if i = 1 then
  163.         return i
  164.     end if
  165.     end for
  166. end function
  167.  
  168. procedure sub()
  169.     y = 200
  170. end procedure
  171.  
  172. procedure overflow()
  173. -- test overflows from integer into floating point
  174.     object two29, two30, maxint, prev_i
  175.     integer two30i, mtwo30i
  176.     sequence s
  177.  
  178.     two30 = 1
  179.     for i = 1 to 30 do
  180.     two30 = two30 * 2
  181.     end for
  182.     s = {two30, two30+1, two30+2}
  183.     s = s + s
  184.     if compare(s, {two30*2, two30*2+2, two30*2+4}) then
  185.     abort()
  186.     end if
  187.     mtwo30i = -1
  188.     for i = 1 to 29 do
  189.     mtwo30i = mtwo30i * 2
  190.     end for
  191.     two30i = 1
  192.     for i = 1 to 29 do
  193.     two30i = two30i * 2
  194.     end for
  195.     if 2 * two30i != -2 * mtwo30i then
  196.     abort()
  197.     end if
  198.     if two30i*2 != two30 then
  199.     abort()
  200.     end if
  201.     two29 = floor(two30 / 2)
  202.     if two29 + two29 != two30 then
  203.        abort()
  204.     end if
  205.  
  206.     maxint = floor(two30 - 1)
  207.     if maxint + 1 != two30 then
  208.     abort()
  209.     end if
  210.  
  211.     if 2 + maxint != two30 + 1 then
  212.     abort()
  213.     end if
  214.  
  215.     if (-maxint - 1) * -1 != two30 then
  216.     abort()
  217.     end if
  218.  
  219.     prev_i = -maxint + 1
  220.     for i = -maxint to -maxint -5 by -1 do
  221.     if i != prev_i - 1 then
  222.         abort()
  223.     end if
  224.     prev_i = i
  225.     end for
  226.  
  227.     prev_i = maxint - 5
  228.     for i = maxint - 3 to maxint + 3 by 2 do
  229.     if i != prev_i + 2 then
  230.         abort()
  231.     end if
  232.     prev_i = i
  233.     end for
  234.  
  235.     if floor(two30) != two30 then
  236.     abort()
  237.     end if
  238.  
  239.     if floor(two30 + two30 - 1) != two30 * 2 - 1 then
  240.     abort()
  241.     end if
  242. end procedure
  243.  
  244. type natural(integer x)
  245.     return x >= 0
  246. end type
  247.  
  248. procedure atomic_ops()
  249. -- test operations on atoms
  250.     object a, x, z
  251.     integer n, m
  252.     natural p
  253.  
  254.     p = 0
  255.     p = 0.000
  256.     p = 4.0/2.0
  257.     if p != 2.0 then
  258.     abort()
  259.     end if    
  260.     n = 1
  261.     m = 1
  262.     if n and m then
  263.     else
  264.     abort()  
  265.     end if
  266.  
  267.     x = 100
  268.     sub() -- y = 200
  269.     z = 300
  270.  
  271.     if x + y != z then
  272.     abort()
  273.     end if
  274.  
  275.     if x != 100 then
  276.     abort()
  277.     end if
  278.  
  279.     if 3 * 3 != 9 or
  280.        3 * 900000000 != 2700000000 or
  281.        15000 * 32000 != 480000000 or
  282.        32000 * 15000 != 480000000 or
  283.        1000 * 13000 != 13000000 or
  284.        13000 * 1000 != 13000000 then
  285.     abort()
  286.     end if
  287.     while x != 100 do
  288.     abort()
  289.     end while
  290.  
  291.     if not (z - y = 100) then
  292.     abort()
  293.     end if
  294.  
  295.     if #FFFFFFFF != 4294967295 then
  296.     abort()
  297.     end if
  298.    
  299.     p = 20
  300.     while not (p < 10) do
  301.     p = p - 2       
  302.     end while
  303.     if p != 8 then
  304.     abort()
  305.     end if
  306.  
  307.     if x * 1000.5 != 100050 or x * y != 20000 or x / y != 0.5 then
  308.     abort()
  309.     end if
  310.  
  311.     if y < x then
  312.     abort()
  313.     end if
  314.  
  315.     if y <= x then
  316.     abort()
  317.     end if
  318.  
  319.     if x > y then
  320.     abort()
  321.     end if
  322.  
  323.     if x >= y then
  324.     abort()
  325.     end if
  326.  
  327.     if -x != -100 then
  328.     abort()
  329.     end if
  330.  
  331.     if x = x and y > z then
  332.     abort()
  333.     end if
  334.  
  335.     x = 0
  336.  
  337.     y = {"ten", "one", "two", "three", "four", "five", "six", "seven", "eight",
  338.      "nine", "ten", "ten"}
  339.  
  340.     while x <= 11 do
  341.     if x = 1 then a = "one"
  342.     elsif x = 2 then a = "two"
  343.     elsif x = 3 then a = "three"
  344.     elsif x = 4 then a = "four"
  345.     elsif x = 5 then a = "five"
  346.     elsif x = 6 then a = "six"
  347.     elsif x = 7 then a = "seven"
  348.              if 1 + 1 = 2 then
  349.                  same(a, "seven")
  350.              elsif 1 + 1 = 3 then
  351.                  abort()
  352.              else
  353.                  abort()
  354.              end if
  355.     elsif x = 8 then a = "eight"
  356.     elsif x = 9 then a = "nine"
  357.     else a = "ten"
  358.     end if
  359.     same(a, y[1+x])
  360.     x = x + 1
  361.     end while
  362.  
  363.     y = 0
  364.     for xx = 100 to 0 by -2 do
  365.     y = y + xx
  366.     end for
  367.     same(y, 50 * 51)
  368.  
  369.     for xx = 1 to 10 do
  370.     if xx = 6 then
  371.         x = 6
  372.         exit
  373.     end if
  374.     y = 1
  375.     while y < 25 do
  376.         y = y + 1
  377.         if y = 18 then
  378.         exit
  379.         end if
  380.     end while
  381.     same(y, 18)
  382.     end for
  383.     y = repeat(-99, 7)
  384.     for xx = +3 to -3 by -1 do
  385.     y[xx+4] = xx
  386.     end for
  387.     same(y, {-3, -2, -1, 0, +1, +2, +3})
  388.  
  389.     y = {1,2,3}
  390.     for xx = 1.5 to +3.0 by .5 do
  391.       y[xx] = xx
  392.     end for
  393.     same(y, {1.5, 2.5, 3.0})
  394.     y = {}
  395.     for xx = -9.0 to -9.5 by -.25 do
  396.       y = y & xx
  397.     end for
  398.     same(y, {-9, -9.25, -9.5})
  399.     y = {}
  400.     for i = 800000000 to 900000000 by 800000000 do
  401.     y = append(y, i)        
  402.     end for
  403.     if compare(y, {800000000}) then
  404.     abort()
  405.     end if
  406.     y = 5
  407.     n = 3
  408.     a = 2
  409.     for i = 1 to y by a do
  410.     n = n - 1
  411.     y = 155
  412.     a = 1
  413.     end for
  414.     same(n, 0)
  415. end procedure
  416.  
  417. procedure floating_pt()
  418. -- test floating-point operations
  419.     sequence x
  420.     atom final
  421.  
  422.     x = {1.5, -3.5, 1e10, -1e20, 0.0, 0.0001}
  423.     y = repeat(x, 10)
  424.     if x[1]/x[2] > -0.42 or x[1]/x[2] < -0.43 then
  425.     abort()
  426.     end if
  427.     if find(1e10, x) != 3 then
  428.     abort()
  429.     end if
  430.     for a = -1.0 to sqrt(999) by 2.5 do
  431.     if a > 20.0 then
  432.         final = a
  433.         exit
  434.     end if
  435.     end for
  436.     if final < 20.0 or final > 23 then
  437.     abort()
  438.     end if
  439. end procedure
  440.  
  441. function one()
  442.     return 1
  443. end function
  444.  
  445. function two()
  446.     return 2.000
  447. end function
  448.  
  449. function sequence_ops()
  450. -- test operations on sequences
  451.     object i, w, x, y, z
  452.     sequence s
  453.     integer j
  454.  
  455.     x = "Hello "
  456.     y = "World"
  457.  
  458.     if find(0, x = x) then
  459.     abort()
  460.     end if
  461.     if x[two()*two() - two()] != 'e' then
  462.     abort()
  463.     end if
  464.     if x[one()+one()] != x[two()] then
  465.     abort()
  466.     end if
  467.  
  468.     j = x[1]
  469.     if j != 'H' then
  470.     abort()
  471.     end if
  472.     s = {3.0}
  473.     s[1] = 1.0000
  474.     j = s[1]
  475.     if j != 1 then
  476.     abort()
  477.     end if
  478.     i = 1
  479.     if not atom(i) or not integer(i) then 
  480.     abort()
  481.     end if
  482.     if length(y) != 5 then 
  483.     abort()
  484.     end if
  485.     while i <= 5 do
  486.     x = append(x, y[i])
  487.     i = i + 1
  488.     end while
  489.     i = 1
  490.     while i <= 3 do
  491.     x = append(x, '.')
  492.     x = append(x, '\'')
  493.     i = i + 1
  494.     end while
  495.     same(x, "Hello World.'.'.'")
  496.     x = {}
  497.     x = append(x, {20,30,5})
  498.     same(x, {{20,30,5}})
  499.     x = repeat(5, 19)
  500.     x = append(x, 20)
  501.     x[7] = 9
  502.     y = {9, 9, {9}}
  503.     y = prepend(y, 8)
  504.     y = prepend(y, {9, 9})
  505.     same(y, {{9, 9}, 8, 9, 9, {9}})
  506.     y = x
  507.     z = y * x + x + 1000
  508.     w = z > 1030 or x = 9
  509.     same(z, {1030, 1030, 1030, 1030, 1030, 1030, 1090, 1030, 1030, 1030,
  510.          1030, 1030, 1030, 1030, 1030, 1030, 1030, 1030, 1030, 1420})
  511.     same(w, {0, 0, 0, 0, 0, 0, 1, 0, 0, 0,
  512.          0, 0, 0, 0, 0, 0, 0, 0, 0, 1})
  513.     x = {100, 200, {1, 2, {0, 0, 0}}, 300}
  514.     x[3][3][3] = 26
  515.     x[3][3][3] = x[3][3][3]-1
  516.     x = x * x
  517.     same(x, {10000, 40000, {1, 4, {0, 0, 625}}, 90000})
  518.     y = x / {1, 2, 3, 4}
  519.     same(y, {10000, 20000, {1/3, 4/3, {0, 0, 625/3}}, 22500})
  520.     -- & tests
  521.  
  522.     same(2 & {5, 6,7}, {2, 5, 6, 7})
  523.     same({} & 3, {3})
  524.     same("ABC" & "DEF" & "GHIJ" & {}, "ABCDEFGHIJ")
  525.     same('A' & 'B' & 'C', "ABC")
  526.  
  527.     -- slice tests
  528.     x = "ABCDEFGHIJKLMNOP"
  529.     same(x[1..4], "ABCD")
  530.     y = x[2..5]
  531.     same(y, "BCDE")
  532.     same(x[4..3], {})
  533.     same(x[4..4], "D")
  534.     x[3..5] = "000"
  535.     same(x, "AB000FGHIJKLMNOP")
  536.     x[6..9] = '8'
  537.     same(x, "AB0008888JKLMNOP")
  538.  
  539.     same(floor({1, 2, -3, 4, -5} / 3), {0, 0, -1, 1, -2})
  540.  
  541.     return y
  542. end function
  543.  
  544.  
  545. procedure sequence_ops2()
  546. -- more tests of sequence operations
  547. object x, y
  548.  
  549.     x = "ABCDEFGHIJKLMNOP"
  550.     if find('D', x) != 4 then
  551.     abort()
  552.     end if
  553.     if match("EFGH", x) != 5 then
  554.     abort()
  555.     end if
  556.     if match({"AB", "CD"}, {0, 1, 3, {}, {"AB", "C"}, "AB", "CD", "EF"}) != 6 then
  557.     abort()
  558.     end if
  559.     if compare(x,x) != 0 then
  560.     abort()
  561.     end if
  562.     if compare({}, {}) != 0 then
  563.     abort()
  564.     end if
  565.     y = repeat(repeat(repeat(99, 5), 5), 5)
  566.     if y[3][3][3] != 99 then
  567.     abort()
  568.     end if
  569.     if compare(y[4][4][3..5], repeat(99, 3)) != 0 then
  570.     abort()
  571.     end if
  572.     y[3][2][1..4] = 88
  573.     if compare(y[3][2], {88, 88, 88, 88, 99}) != 0 then
  574.     abort()
  575.     end if
  576. end procedure
  577.  
  578. procedure circularity()
  579. -- test for circular references in internal garbage collector
  580.     object x, y
  581.  
  582.     x = {{"abc", {0, 0, 0}}, "def", 1, 2}
  583.     x[3] = x
  584.     x[1..2] = x[2..3]
  585.     x = append(x, x)
  586.     x = prepend(x, x)
  587.     if compare(x, x) != 0 then
  588.     abort()
  589.     end if
  590.     y = "ABCDE"
  591.     y[2] = repeat(y, 3)
  592.     if compare(y, y) != 0 then
  593.     abort()
  594.     end if
  595. end procedure
  596.  
  597. procedure patterns()
  598. -- test wildcard routines   
  599.     if wildcard_file("ABC*DEF.*", "XBCDEF.E") then
  600.     abort()
  601.     end if
  602.     if not wildcard_file("A?B?C?D", "a1b2C3D") then
  603.     abort()
  604.     end if
  605.     if wildcard_match("AAA", "AAa") then
  606.     abort()
  607.     end if
  608.     if not wildcard_match("??Z*Z*", "ABZ123Z123") then
  609.     abort()
  610.     end if
  611. end procedure
  612.  
  613. procedure conversions()
  614. -- test conversion of values to/from string representation   
  615.     sequence v
  616.     
  617.     v = sprintf("values are: %5d, %3d, %4.2f", {1234, -89, 6.22})
  618.     if compare(v, "values are:  1234, -89, 6.22") != 0 then
  619.     abort()
  620.     end if
  621.     v = value("{1,2,3}")
  622.     if compare(v, {GET_SUCCESS, {1,2,3}}) != 0 then
  623.     abort()
  624.     end if
  625.     for x = 1 to 100 by 3 do
  626.     v = value(sprintf("%d", x)) 
  627.     if compare(v, {GET_SUCCESS, x}) != 0 then
  628.         abort()
  629.     end if
  630.     v = value(sprintf("#%x ", x))
  631.     if compare(v, {GET_SUCCESS, x}) != 0 then
  632.         abort()
  633.     end if
  634.     end for
  635. end procedure
  636.  
  637. procedure output()
  638. -- test file output routines
  639.     integer file_no
  640.  
  641.     file_no = open("sanityio.tst", "w")
  642.     if file_no < 0 then
  643.     abort() 
  644.     end if
  645.     puts(file_no, "-- io test\n")
  646.     print(file_no, {1,2,3})
  647.     puts(file_no, '\n')
  648.     print(file_no, -99)
  649.     puts(file_no, " {11, {33, {#33}}, 4, 5 }{\t\t}\n")
  650.     puts(file_no, "{} .999 -.999 1.55e00 {11,   22 , {33, 33}, 4, 5  }\n") 
  651.     printf(file_no, "%e", 10000)
  652.     printf(file_no, " %d", -123)
  653.     printf(file_no, " %5.1f", 5+1/2)
  654.     printf(file_no, "%50s\n", {"+99 1001 {1,2,3} 1E-4 {1.002e23,-59e-5,"})
  655.     printf(file_no, "%9e}\t\t-1e-20\t   -.00001e5\n", 59e30)
  656.     puts(file_no, "\"Rob\"\"ert\" \"Craig\"  ")
  657.     puts(file_no, "\"\" \"\\n\" \"\\t\\r\"\t")
  658.     puts(file_no, "\"\\'\\\"\" 'A' '\\n' '\\\"' '\\'' '\\r'\n")
  659.     printf(file_no, "{#%x, ", 291)
  660.     puts(file_no, "\"ABC\"} {'A', 'B', '\\n'}")  
  661.     close(file_no)
  662. end procedure
  663.  
  664. procedure input()
  665. -- test file input routines
  666.     integer file_no
  667.     object line
  668.     integer char
  669.  
  670.     file_no = open("sanityio.tst", "r")
  671.     if file_no < 0 then
  672.     abort()
  673.     end if
  674.     if seek(file_no, 5) then
  675.     abort()
  676.     end if
  677.     if seek(file_no, -1) then
  678.     abort()
  679.     end if
  680.     if seek(file_no, 0) then
  681.     abort()
  682.     end if
  683.     if where(file_no) != 0 then
  684.     abort()
  685.     end if
  686.     line = gets(file_no)
  687.     if compare(line, "-- io test\n") != 0 then
  688.     abort()
  689.     end if
  690.     char = getc(file_no)
  691.     if char != '{' then
  692.     abort()
  693.     end if
  694.     close(file_no)
  695. end procedure
  696.  
  697. without type_check
  698. integer color
  699. color = 1
  700. sequence v
  701.  
  702. procedure testgr()
  703. -- test basic VGA graphics operations
  704.     sequence x
  705.     
  706.     if v[VC_XPIXELS] < 100 or v[VC_YPIXELS] < 100 then
  707.     abort()
  708.     end if
  709.     draw_line(BLUE, {{20, 100}, {600, 100}})
  710.     for i = 1 to 200 by 5 do
  711.     pixel(WHITE, {3*i, i})
  712.     if get_pixel({3*i, i}) != 7 then
  713.         abort()
  714.     end if
  715.     end for
  716.     polygon(color, 0, {{20,350}, {40, 250}, {80, 400}})
  717.     ellipse(color+5, 1, {350, 350}, {440,440})
  718.     color = color + 1
  719.     x = {}
  720.     for i = 0 to 63 do
  721.     x = x & repeat(i, 2)
  722.     end for
  723.     for p = 220 to 320 by 4 do
  724.     display_image({p,p}, repeat(x+color, 2))
  725.     end for
  726. end procedure
  727. with type_check
  728.  
  729. constant TRUE = 1, FALSE = 0
  730.  
  731. procedure testget()
  732. -- test input of Euphoria objects
  733.     object gd
  734.     object x, i
  735.     object results
  736.  
  737.     gd = open("sanityio.tst", "r")
  738.     if gd < 0 or gd > 10 then
  739.     abort()
  740.     end if
  741.     if not sequence(gets(gd)) then
  742.     abort()
  743.     end if
  744.     results = {
  745.      {0, {1,2,3}},
  746.      {0, -99},
  747.      {0, {11, {33, {#33}}, 4, 5}},
  748.      {0, {}},
  749.      {0, {}},
  750.      {0, 0.999},
  751.      {0, -0.999},
  752.      {0, 1.55},
  753.      {0, {11, 22, {33, 33}, 4, 5}},
  754.      {0, 10000},
  755.      {0, -123},
  756.      {0, 5.5},
  757.      {0, 99},
  758.      {0, 1001},
  759.      {0, {1, 2, 3}},
  760.      {0, 0.0001},
  761.      {0, {1.002e+23, -0.00059, 5.9e+31}},
  762.      {0, -1e-20},
  763.      {0, -1},
  764.      {0, "Rob"},
  765.      {0, "ert"},
  766.      {0, "Craig"},
  767.      {0, ""},
  768.      {0, "\n"},
  769.      {0, "\t\r"},
  770.      {0, "\'\""},
  771.      {0, 'A'},
  772.      {0, '\n'},
  773.      {0, '\"'},
  774.      {0, '\''},
  775.      {0, '\r'},
  776.      {0, {#123, "ABC"}},
  777.      {0, {'A', 'B', '\n'}},
  778.      {-#1, 0}
  779.     }
  780.     i = 1
  781.     while TRUE do
  782.     x = get(gd)
  783.     if x[1] = -1 then
  784.         exit
  785.     end if
  786.     same(x, results[i])
  787.     i = i + 1
  788.     end while
  789.     if compare(results[i], {-1, 0}) != 0 then
  790.     puts(2, "wrong number of get values\n")
  791.     end if
  792.     close(gd)
  793. end procedure
  794.  
  795. function fib(integer n)
  796. -- fibonacci
  797.     if n < 2 then
  798.     return n
  799.     else
  800.     return fib(n-1) + fib(n-2)
  801.     end if
  802. end function
  803.  
  804. integer rp
  805.  
  806. procedure recursive_proc()
  807. -- a recursively-called procedure
  808.     if rp > 0 then
  809.     rp = rp - 1
  810.     recursive_proc()
  811.     end if
  812. end procedure
  813.  
  814. procedure machine_level()
  815. -- quick test of machine-level routines
  816.     atom addr
  817.  
  818.     addr = allocate(100)
  819.     poke(addr, {77, -1, 5.1, -1.1})
  820.     if compare(peek({addr, 4}), {77, 255, 5, 255}) then
  821.     abort()
  822.     end if
  823.     poke(addr, #C3) -- RET instruction
  824.     if peek(addr) != #C3 then
  825.     abort()
  826.     end if
  827.     call(addr)
  828.     free(addr)
  829.     for x = 0 to +2000000 by 99999 do
  830.     if bytes_to_int(int_to_bytes(x)) != x then
  831.         abort()
  832.     end if
  833.     end for
  834.     if bits_to_int({1,0,1,0}) != 5 then
  835.     abort()
  836.     end if
  837.     if compare(int_to_bits(17,8), {1,0,0,0,1,0,0,0}) != 0 then
  838.     abort()
  839.     end if
  840. end procedure
  841.  
  842. global type sorted(sequence x)
  843. -- return TRUE if x is in ascending order
  844.     for i = 1 to length(x)-1 do
  845.     if compare(x[i], x[i+1]) > 0 then
  846.         return FALSE
  847.     end if
  848.     end for
  849.     return TRUE
  850. end type
  851.  
  852. without profile
  853.  
  854. global procedure sanity()
  855. -- main program
  856.     sequence cmd_line, save_colors
  857.     integer vga
  858.  
  859.     vga = not graphics_mode(18) 
  860.     v = video_config()
  861.     clear_screen()
  862.     position(12, 20)
  863.     if compare({12, 20}, get_position()) != 0 then
  864.     abort()
  865.     end if
  866.     puts(msg, "Euphoria SANITY TEST ... ")
  867.  
  868.     for j = 0 to 8 by 2 do
  869.     if atom(getenv("EUDIR")) then
  870.         puts(1, "\nEUDIR environment variable not set - see install.doc\n")
  871.         puts(1, "\nPress Enter to continue...\n")
  872.         the_end()
  873.     end if
  874.     cmd_line = command_line()
  875.     if length(cmd_line) < 1 or length(cmd_line) > 10 then
  876.         abort()
  877.     end if
  878.     if length(current_dir()) < 2 then
  879.         abort()
  880.     end if
  881.     if length(dir(".")) < 2 then
  882.         abort()
  883.     end if
  884.     if vga then
  885.         testgr()
  886.     end if
  887.     make_sound()
  888.     same(built_in(), 1)
  889.     atomic_ops()
  890.     overflow()
  891.     floating_pt()
  892.     if compare(sequence_ops(), "BCDE") != 0 then
  893.         puts(msg, "sequence_ops failed\n")
  894.     end if
  895.     sequence_ops2()
  896.     circularity()
  897.     output()
  898.     input()
  899.     testget()
  900.     conversions()
  901.     patterns()
  902.     system("del sanityio.tst", 2)
  903.     machine_level()
  904.     rp = 100
  905.     recursive_proc()
  906.     if rp != 0 then
  907.         puts(msg, "recursive proc failed\n")
  908.     end if
  909.     if fib(20) != 6765 then
  910.         puts(msg, "fib failed\n")
  911.     end if
  912.     if not sorted(sort(-500 + rand(repeat(1000, 1000)))) then
  913.         puts(msg, "standard sort failed\n")
  914.     end if
  915.     if not sorted(sort({"robert", "junko", "dave", "ken", "lurdes"})) then
  916.         puts(msg, "standard general sort failed\n")
  917.     end if
  918.     end for
  919.     
  920.     save_colors = {}
  921.     for i = 0 to v[VC_NCOLORS]-1 do
  922.     save_colors = append(save_colors, palette(i, {0,0,0}))
  923.     end for
  924.     for i = 1 to 200 do
  925.     sound(i*15)
  926.     all_palette(rand(repeat({63,63,63}, v[VC_NCOLORS])))
  927.     end for
  928.     sound(0)
  929.     all_palette(save_colors)
  930.     printf(msg, "%s\n", {"PASSED (100%)\n\n  <Enter> to continue"})
  931.     the_end()    
  932. end procedure
  933.  
  934. integer z
  935.  
  936. -- another for-loop test
  937. z = 0
  938. for j = 1 to 10 do
  939.     z = z + j
  940. end for
  941. if z != 55 then
  942.     abort()
  943. end if
  944.  
  945. sanity()
  946.  
  947.